home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
kcl
/
kcl.lha
/
cmpnew
/
cmpcatch.c
< prev
next >
Wrap
C/C++ Source or Header
|
1987-06-04
|
9KB
|
324 lines
/* (C) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved. */
#include <cmpinclude.h>
#include "cmpcatch.h"
init_cmpcatch(start,size,data)char *start;int size;object data;
{ register object *base=vs_top;register object *sup=base+VM2;vs_top=sup;vs_check;
Cstart=start;Csize=size;Cdata=data;set_VV(VV,VM1,data);
(void)(putprop(VV[0],VV[1],VV[2]));
(void)(putprop(VV[0],VV[3],VV[4]));
(void)(putprop(VV[5],VV[6],VV[2]));
(void)(putprop(VV[5],VV[7],VV[4]));
(void)(putprop(VV[8],VV[9],VV[2]));
(void)(putprop(VV[8],VV[10],VV[4]));
MF(VV[1],L7,start,size,data);
(void)(putprop(VV[14],VV[15],VV[16]));
MF(VV[3],L9,start,size,data);
MF(VV[15],L10,start,size,data);
MF(VV[6],L11,start,size,data);
MF(VV[7],L12,start,size,data);
MF(VV[9],L13,start,size,data);
MF(VV[10],L14,start,size,data);
vs_top=vs_base=base;
}
/* function definition for C1CATCH */
static L7()
{ register object *base=vs_base;
register object *sup=base+VM3;
vs_reserve(VM3);
check_arg(1);
vs_top=sup;
TTL:;
base[2]= VV[11];
base[3]= Ct;
base[1]= simple_symlispcall_no_event(VV[35],base+2,2);
base[2]= Cnil;
if(!(endp(base[0]))){
goto T11;}
base[3]= VV[0];
base[4]= VV[12];
base[5]= VV[13];
(void)simple_symlispcall_no_event(VV[36],base+3,3);
T11:;
base[3]= car(base[0]);
base[2]= simple_symlispcall_no_event(VV[37],base+3,1);
base[3]= base[1];
base[4]= cadr(base[2]);
(void)simple_symlispcall_no_event(VV[38],base+3,2);
base[3]= cdr(base[0]);
base[0]= simple_symlispcall_no_event(VV[39],base+3,1);
base[3]= base[1];
base[4]= cadr(base[0]);
(void)simple_symlispcall_no_event(VV[38],base+3,2);
base[3]= list(4,VV[0],base[1],base[2],base[0]);
vs_top=(vs_base=base+3)+1;
return;
}
/* function definition for C2CATCH */
static L9()
{ register object *base=vs_base;
register object *sup=base+VM4;
vs_reserve(VM4);
bds_check;
check_arg(2);
vs_top=sup;
TTL:;
bds_bind(VV[17],symbol_value(VV[17]));
bds_bind(VV[18],VV[19]);
base[4]= base[0];
base[5]= simple_symlispcall_no_event(VV[40],base+4,1);
bds_unwind1;
princ_str("\n if(nlj_active)",VV[20]);
princ_str("\n {nlj_active=FALSE;frs_pop();",VV[20]);
base[3]= VV[21];
base[4]= VV[22];
(void)simple_symlispcall_no_event(VV[41],base+3,2);
princ_char(125,VV[20]);
princ_str("\n else{",VV[20]);
base[3]= make_cons(VV[24],symbol_value(VV[23]));
bds_bind(VV[23],base[3]);
base[4]= base[1];
base[5]= simple_symlispcall_no_event(VV[42],base+4,1);
bds_unwind1;
princ_char(125,VV[20]);
base[3]= Cnil;
vs_top=(vs_base=base+3)+1;
bds_unwind1;
return;
}
/* function definition for SET-PUSH-CATCH-FRAME */
static L10()
{ register object *base=vs_base;
register object *sup=base+VM5;
vs_reserve(VM5);
check_arg(1);
vs_top=sup;
TTL:;
princ_str("\n frs_push(FRS_CATCH,",VV[20]);
base[1]= base[0];
(void)simple_symlispcall_no_event(VV[43],base+1,1);
princ_str(");",VV[20]);
base[1]= Cnil;
vs_top=(vs_base=base+1)+1;
return;
}
/* function definition for C1UNWIND-PROTECT */
static L11()
{ register object *base=vs_base;
register object *sup=base+VM6;
vs_reserve(VM6);
bds_check;
check_arg(1);
vs_top=sup;
TTL:;
base[2]= VV[11];
base[3]= Ct;
base[1]= simple_symlispcall_no_event(VV[35],base+2,2);
base[2]= Cnil;
if(!(endp(base[0]))){
goto T53;}
base[3]= VV[5];
base[4]= VV[12];
base[5]= VV[13];
(void)simple_symlispcall_no_event(VV[36],base+3,3);
T53:;
base[3]= make_cons(VV[26],symbol_value(VV[25]));
base[4]= make_cons(VV[26],symbol_value(VV[27]));
base[5]= make_cons(VV[26],symbol_value(VV[28]));
bds_bind(VV[25],base[3]);
bds_bind(VV[27],base[4]);
bds_bind(VV[28],base[5]);
base[6]= car(base[0]);
base[7]= simple_symlispcall_no_event(VV[37],base+6,1);
bds_unwind1;
bds_unwind1;
bds_unwind1;
base[2]= base[7];
base[3]= base[1];
base[4]= cadr(base[2]);
(void)simple_symlispcall_no_event(VV[38],base+3,2);
base[3]= cdr(base[0]);
base[0]= simple_symlispcall_no_event(VV[39],base+3,1);
base[3]= base[1];
base[4]= cadr(base[0]);
(void)simple_symlispcall_no_event(VV[38],base+3,2);
base[3]= list(4,VV[5],base[1],base[2],base[0]);
vs_top=(vs_base=base+3)+1;
return;
}
/* function definition for C2UNWIND-PROTECT */
static L12()
{ register object *base=vs_base;
register object *sup=base+VM7;
vs_reserve(VM7);
bds_check;
check_arg(2);
vs_top=sup;
TTL:;
bds_bind(VV[17],symbol_value(VV[17]));
base[4]= simple_symlispcall_no_event(VV[44],base+5,0);
base[3]= list(2,VV[29],base[4]);
princ_str("\n {object tag;frame_ptr fr;object p;bool active;",VV[20]);
princ_str("\n frs_push(FRS_PROTECT,Cnil);",VV[20]);
princ_str("\n if(nlj_active){tag=nlj_tag;fr=nlj_fr;active=TRUE;}",VV[20]);
princ_str("\n else{",VV[20]);
bds_bind(VV[18],VV[30]);
base[5]= base[0];
base[6]= simple_symlispcall_no_event(VV[40],base+5,1);
bds_unwind1;
princ_str("\n active=FALSE;}",VV[20]);
princ_str("\n ",VV[20]);
base[4]= base[3];
(void)simple_symlispcall_no_event(VV[43],base+4,1);
princ_str("=Cnil;",VV[20]);
princ_str("\n while(vs_base<vs_top)",VV[20]);
princ_str("\n {",VV[20]);
base[4]= base[3];
(void)simple_symlispcall_no_event(VV[43],base+4,1);
princ_str("=MMcons(vs_top[-1],",VV[20]);
base[4]= base[3];
(void)simple_symlispcall_no_event(VV[43],base+4,1);
princ_str(");vs_top--;}",VV[20]);
princ_str("\n ",VV[20]);
(void)simple_symlispcall_no_event(VV[45],base+4,0);
princ_str("\n nlj_active=FALSE;frs_pop();",VV[20]);
bds_bind(VV[18],VV[31]);
base[5]= base[1];
base[6]= simple_symlispcall_no_event(VV[40],base+5,1);
bds_unwind1;
princ_str("\n vs_base=vs_top=base+",VV[20]);
base[4]= (VV[17]->s.s_dbind);
(void)simple_symlispcall_no_event(VV[43],base+4,1);
princ_char(59,VV[20]);
setq(VV[32],Ct);
princ_str("\n for(p= ",VV[20]);
base[4]= base[3];
(void)simple_symlispcall_no_event(VV[43],base+4,1);
princ_str(";!endp(p);p=MMcdr(p))vs_push(MMcar(p));",VV[20]);
princ_str("\n if(active)unwind(fr,tag);else{",VV[20]);
base[4]= VV[21];
(void)simple_symlispcall_no_event(VV[41],base+4,1);
princ_str("}}",VV[20]);
base[4]= Cnil;
vs_top=(vs_base=base+4)+1;
bds_unwind1;
return;
}
/* function definition for C1THROW */
static L13()
{ register object *base=vs_base;
register object *sup=base+VM8;
vs_reserve(VM8);
check_arg(1);
vs_top=sup;
TTL:;
base[1]= simple_symlispcall_no_event(VV[35],base+2,0);
base[2]= Cnil;
if(endp(base[0])){
goto T128;}
if(!(endp(cdr(base[0])))){
goto T127;}
T128:;
base[3]= VV[8];
base[4]= VV[33];
base[5]= make_fixnum(length(base[0]));
(void)simple_symlispcall_no_event(VV[36],base+3,3);
T127:;
if(endp(cddr(base[0]))){
goto T135;}
base[3]= VV[8];
base[4]= VV[33];
base[5]= make_fixnum(length(base[0]));
(void)simple_symlispcall_no_event(VV[46],base+3,3);
T135:;
base[3]= car(base[0]);
base[2]= simple_symlispcall_no_event(VV[37],base+3,1);
base[3]= base[1];
base[4]= cadr(base[2]);
(void)simple_symlispcall_no_event(VV[38],base+3,2);
base[3]= cadr(base[0]);
base[0]= simple_symlispcall_no_event(VV[37],base+3,1);
base[3]= base[1];
base[4]= cadr(base[0]);
(void)simple_symlispcall_no_event(VV[38],base+3,2);
base[3]= list(4,VV[8],base[1],base[2],base[0]);
vs_top=(vs_base=base+3)+1;
return;
}
/* function definition for C2THROW */
static L14()
{ register object *base=vs_base;
register object *sup=base+VM9;
vs_reserve(VM9);
bds_check;
check_arg(2);
vs_top=sup;
TTL:;
bds_bind(VV[17],symbol_value(VV[17]));
base[3]= Cnil;
princ_str("\n {frame_ptr fr;",VV[20]);
{object V1= car(base[0]);
if((V1!= VV[47]))goto T156;
base[3]= caddr(base[0]);
goto T155;
T156:;
if((V1!= VV[34]))goto T158;
{object V2;
V2= caaddr(base[0]);
{object V3= structure_ref((V2),VV[34],1);
if((V3!= VV[48]))goto T160;
base[3]= list(2,VV[29],structure_ref((V2),VV[34],2));
goto T155;
T160:;
if((V3!= VV[49]))goto T162;
base[3]= structure_ref((V2),VV[34],4);
goto T155;
T162:;
base[4]= simple_symlispcall_no_event(VV[44],base+5,0);
base[3]= list(2,VV[29],base[4]);
princ_str("\n ",VV[20]);
base[4]= base[3];
(void)simple_symlispcall_no_event(VV[43],base+4,1);
princ_str("= ",VV[20]);
base[4]= (V2);
base[5]= Cnil;
(void)simple_symlispcall_no_event(VV[50],base+4,2);
princ_char(59,VV[20]);
goto T155;}}
T158:;
base[4]= simple_symlispcall_no_event(VV[44],base+5,0);
base[3]= list(2,VV[29],base[4]);
bds_bind(VV[18],base[3]);
base[5]= base[0];
base[6]= simple_symlispcall_no_event(VV[40],base+5,1);
bds_unwind1;}
T155:;
princ_str("\n fr=frs_sch_catch(",VV[20]);
base[4]= base[3];
(void)simple_symlispcall_no_event(VV[43],base+4,1);
princ_str(");",VV[20]);
princ_str("\n if(fr==NULL) FEerror(\"The tag ~s is undefined.\",1,",VV[20]);
base[4]= base[3];
(void)simple_symlispcall_no_event(VV[43],base+4,1);
princ_str(");",VV[20]);
bds_bind(VV[18],VV[30]);
base[5]= base[1];
base[6]= simple_symlispcall_no_event(VV[40],base+5,1);
bds_unwind1;
princ_str("\n unwind(fr,",VV[20]);
base[4]= base[3];
(void)simple_symlispcall_no_event(VV[43],base+4,1);
princ_str(");}",VV[20]);
base[4]= Cnil;
vs_top=(vs_base=base+4)+1;
bds_unwind1;
return;
}